home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / REMLIFE.ARJ / LIFE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-08-16  |  5KB  |  141 lines

  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  7.  
  8. program life;
  9.  
  10.  
  11.                     { This is the Game Of Life }
  12.  
  13.  
  14.  
  15. Uses
  16.   Crt, {Unit found in TURBO.TPL}
  17.   Turbo3; {Unit found in TURBO3.TPU}
  18.  
  19. const
  20.      max = 8;                                  { Maximum number array elements}
  21.      max_gen = 10;                             { Max Generations }
  22.  
  23. type
  24.      r1  = array [1..max,1..max] of integer;   { Main type of array }
  25.  
  26. var
  27.   i         : integer;                         { Row Index }
  28.   j         : integer;                         { Column Index }
  29.   gen       : integer;                         { Generation index }
  30.   print_code: integer;                         { print_code }
  31.   board_a   : r1;                              { Main Life Board }
  32.   board_b   : r1;                              { Secondary board }
  33.  
  34.  
  35.  
  36. procedure check_life(a:r1; var b:r1; x,y:integer);
  37.  
  38. var
  39.   total_lives : integer;
  40.   living      : boolean;
  41.  
  42. Begin
  43.   total_lives := 0;     { Just to be safe }
  44.   total_lives := a[x,y+1] + a[x,y-1] + a[x+1,y] + a[x-1,y] +
  45.                  a[x+1,y+1] + a[x+1,y-1] + a[x-1,y+1] + a[x-1,y-1];
  46.   if a[x,y] = 0                    { Determine if person is living there }
  47.      then living := false
  48.      else living := true;
  49.   case living of
  50.        true   :                        { If living, then check for survival }
  51.                  case total_lives of
  52.                       2,3      : b[x,y] := 1;    { Survives }
  53.                       0,1,4..8 : b[x,y] := 0;    { dies     }
  54.                  end;
  55.  
  56.        false  :                        { if not living, then check for birth }
  57.                  case total_lives of
  58.                       0..2,4..8: b[x,y] := 0;    { Not Born }
  59.                       3        : b[x,y] := 1;    { Born     }
  60.                  end;
  61.   end;
  62. End;      { Procedure }
  63.  
  64.  
  65.  
  66. procedure print_out(a:r1;     gen_num,        code:integer);
  67.                   { ^matrix,  ^generation,    ^ what procedure called it. }
  68. var
  69.   i,j : integer;
  70.   junk : char;
  71.  
  72. Begin
  73.   clrscr;
  74.   writeln ('Generation = ',gen_num);
  75.   writeln;
  76.   for i := 1 to max do
  77.     begin
  78.       for j := 1 to max do
  79.         write (a[i,j]:2);
  80.       writeln;
  81.     end;
  82.   writeln;
  83.   writeln;
  84.   if (gen_num < max_gen) and (code <> 1)
  85.      then begin
  86.             write ('Press ENTER to continue.....');
  87.             readln (junk)
  88.           end;
  89. End;
  90.  
  91.  
  92. procedure init;         { Initialize the main array and variables }
  93.  
  94. var
  95.   response : char;
  96.   tp,tcode : integer;
  97.  
  98. Begin
  99.   for i := 1 to max do
  100.     begin
  101.       board_a[i,max] := 0;          { Initialize the edges to 0 }
  102.       board_a[max,i] := 0;
  103.       board_a[i,1]   := 0;
  104.       board_a[1,i]   := 0;
  105.     end;
  106.   board_b := board_a;
  107.   tp := 1;                          { First generation }
  108.   tcode := 1;                       { code the pass }
  109.   repeat
  110.     for i := 2 to max-1 do
  111.      begin
  112.       for j := 2 to max-1 do
  113.         begin
  114.           board_a[i,j] := trunc(random(2));  { Put random lives in array }
  115.           board_b[i,j] := 0;                 { and initialize this one   }
  116.         end;
  117.      end;
  118.     print_out(board_a,tp,tcode);
  119.     write ('Random Generation, Accept ? (Y/N) --> ');  { Random enough? }
  120.     read (kbd,response)                                { Wait 'till pressed }
  121.   until (response = 'y') or (response = 'Y');          { and proper response }
  122. End;
  123.  
  124.  
  125. BEGIN
  126.       init;        { Initialize }
  127.       print_code := 0;                             { Main calling            }
  128.       gen := 1;                                    { First Generation        }
  129.       repeat                                       { Do the following,       }
  130.             print_out(board_a,gen,print_code);     { First print it          }
  131.             for i := 2 to max-1 do                 { Row count               }
  132.               for j := 2 to max-1 do               { Column count            }
  133.                   check_life(board_a,board_b,i,j); { Check life and do stuff }
  134.             gen := succ(gen);                      { Next generation         }
  135.             board_a := board_b                     { Old := New              }
  136.       until gen = max_gen;                         { Until Generation Count  }
  137.       print_out(board_a,gen,print_code);           { Print one last time     }
  138. END.
  139.  
  140.  
  141.